perm filename RHY.F4[MSS,LCS] blob
sn#254538 filedate 1976-12-09 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DIMENSION E(100),F(100),G(100)
C00005 ENDMK
Cā;
DIMENSION E(100),F(100),G(100)
204 TYPE 110
110 FORMAT(' TYPE RHYTHM LINE 1 --'$)
210 FORMAT(' TYPE RHYTHM LINE 2 --'$)
310 FORMAT(100F)
ACCEPT 310,E
TYPE 210
ACCEPT 310,F
X=0
DO 100 K=1,100
IF(E(K).EQ.0)GO TO 101
KE=K
A=4/E(K)
E(K)=A
100 X=X+A
101 Y=0
DO 200 K=1,100
IF(F(K).EQ.0)GO TO 201
KF=K
A=4/F(K)
F(K)=A
200 Y=Y+A
201 IF(ABS(Y-X).LT..01)GO TO 202
TYPE 203
GO TO 204
203 FORMAT(' MISMATCH')
202 CALL RHYTOT(E,KE)
CALL RHYTOT(F,KF)
K=1
L=1
M=0
19 KK=K
LL=L
1 SM=10000
K=K+1
IF(K.GT.KE)GO TO 10
4 L=L+1
Y=F(L)
B=Y-F(L-1)
IF(B.LT.SM)SM=B
2 X=E(K)
A=X-E(K-1)
C A AND B HAVE TRUE DURATIONS NOW
IF(A.LT.SM)SM=A
C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
IF(ABS(X-Y).LT..01)GO TO 3
C JUMP IF EQUAL RHYTHS
IF(X.GT.Y)GO TO 4
K=K+1
C STEP FORWARD UNTIL X IS .GT. Y
GO TO 2
3 IF(K.NE.KK+1)GO TO 13
IF(L.NE.LL+1)GO TO 14
M=M+1
G(M)=E(KK)
GO TO 19
13 IF(L.NE.LL+1)GO TO 15
DO 16 J=KK,K-1
M=M+1
16 G(M)=E(J)
GO TO 19
14 DO 17 J=LL,L-1
M=M+1
17 G(M)=F(J)
GO TO 19
15 XM=SM-.001
M=M+1
P=E(KK)
G(M)=P
7 KK=KK+1
LL=LL+1
YM=SM*1.5
C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
S=P
T=P
27 A=E(KK)
B=F(LL)
IF(ABS(A-B).LT..01)GO TO 19
X=A-P
Y=B-P
S=E(KK-1)
T=F(LL-1)
9 IF(A-S.LT.X)X=A-S
IF(B-T.LT.Y)Y=B-T
IF(A.GT.B)GO TO 8
KK=KK+1
62 IF(X.GT.YM)GO TO 5
IF(X.EQ.0)GO TO 27
P=P+SM
25 M=M+1
G(M)=P
GO TO 27
5 J=X/XM
P=P+SM*J
GO TO 25
8 X=Y
LL=LL+1
GO TO 62
10 M=M+1
G(M)=E(KE)
TYPE 410,(E(K),K=1,KE)
TYPE 410,(F(K),K=1,KF)
TYPE 410,(G(K),K=1,M)
410 FORMAT(12F7.3)
END
SUBROUTINE RHYTOT(E,KE)
DIMENSION E(1)
KE=KE+1
X=E(1)
E(1)=0
DO 50 K=2,KE
Y=E(K)
E(K)=E(K-1)+X
50 X=Y
END